Úvod


KAPITOLA 7

POKRAČOVÁNÍ DPLYRU A GGPLOT2

V předchozích dvou kapitolách jsme se naučili pracovat s balíčky ggplot2 a dplyr. Balíček dplyr však obsahuje kromě nám už známých příkazů i několik dalších, kterým bude věnována právě tato kapitola. Jmenovitě se jedná o příkazy trubka, respektive group_by a summarise.

S těmito třemi příkazy povýšíme naše skripty na zcela novou úroveň, jak sami brzy zjistíte. Jejich užitečnost oceníte nejen při analýze dat, ale i při tvorbě grafů. Pojďme na ně.

Trubka

Column

Peleliu: Trubka

Naše asijské dobrodružství začínáme poněkud zvláštně znějícím operátorem trubka (v angličtině pipe), který nám pomůže naše dlouhé zápisy ve skriptech zkrátit, a přitom zlepšit jejich čitelnost. Trubka se skládá ze tří znaků %>%, jež dokážeme vyvolat pomocí klávesové zkratky Ctrl-Shift-M. Ukažme si na příkladu, co vše trubka dovede. Vítejte na ostrově Peleliu.

Naším prvním úkolem se stane vytvořit databázi Katan2, která bude obsahovat jedince mladší 26 let, kteří chodí do klubů deskových her. Z minulé kapitoly víme, že se nám pro řešení takového úkolu bude nejlépe hodit příkaz filter() z dplyru.

library(dplyr)

Katan2 <- Katan %>%  
  filter(
    Věk <= 25,
    Klub == "člen") 
# A tibble: 59 x 9
   Partie   Věk Pohlaví Vzdělání Kolej Práce     Kouření Klub   Děti
    <dbl> <dbl> <chr>   <chr>    <chr> <chr>     <chr>   <chr> <dbl>
 1      3    14 muž     ZŠ       ne    nepracuje nekouří člen      0
 2      5    15 muž     ZŠ       ne    nepracuje nekouří člen      0
 3      6    15 muž     ZŠ       ne    nepracuje nekouří člen      0
 4      6    15 muž     ZŠ       ne    nepracuje nekouří člen      0
 5      3    15 žena    ZŠ       ne    nepracuje nekouří člen      0
 6      3    15 žena    ZŠ       ne    nepracuje nekouří člen      0
 7      5    16 muž     ZŠ       ne    nepracuje nekouří člen      0
 8      3    16 žena    ZŠ       ne    nepracuje nekouří člen      0
 9      7    16 muž     ZŠ       ne    nepracuje nekouří člen      0
10      5    16 muž     ZŠ       ne    nepracuje nekouří člen      0
# ... with 49 more rows

Zápis předchozího skriptu je dosti odlišný od té podoby, se kterou jsme se seznámili v předchozí kapitole. Podívejme se proto na jejich srovnání v následujícím přehledu.

# skript s trubkou
Katan2 <- Katan %>%  
  filter(
    Věk <= 25,
    Klub == "člen") 

# skript bez trubky
Katan2 <- 
  filter(Katan, 
    Věk <= 25,
    Klub == "člen")

U trubky začínáme názvem databáze, se kterou chceme v příkazu filter() pracovat (pomineme-li samotný název databáze, do které výsledek vložíme, tj. Katan2). Následně přidáme symbol pro trubku a teprve až poté pokračujeme vlastním názvem funkce, v němž už název databáze neuvádíme. Jinými slovy, pomocí trubky vléváme data do příkazu filter().

Abychom si ukázali, že trubka nemusí fungovat pouze v rámci příkazů dplyr, uveďme si další příklad. V něm budeme chtít zjistit průměr proměnné Věk.

# skript s trubkou
Katan$Věk %>%
    mean()

# skript bez trubky
mean(Katan$Věk)
[1] 27.64

Jak je vidět, trubka funguje i u tak obyčejného příkazu, jako je třeba mean(). Jen si prosím vždy dávejte pozor na to, abyste nezapomněli na závorku u samotného příkazu. Ačkoliv je zde sice prázdná, je i tak naprosto nezbytná. Závorku si můžete představit jako nádrž, do které budete data vlévat. Bez ní se vám data rozlijí a skript nahlásí error.

Vzhledem k předchozímu představení trubky kdekoho jistě napadne otázka, a k čemu je trubka vlastně užitečná? Jistě, u výše uvedených příkazů nám toho příliš mnoho nepřinesla, pokud vůbec. Až ale začneme tvořit v dalších částech této kapitoly složitější skripty, bude se nám velice hodit. Užitečnost trubky nicméně lze demonstrovat i u jednodušších příkazů, jako je třeba hned ten následující, ve kterém najednou použijeme příkazy select(), filter() a rename().

Katan2 <- Katan %>%
  select(Věk, Pohlaví) %>%
  filter(Věk < 18) %>%
  rename("Age" = Věk, "Gender" = Pohlaví)
# A tibble: 26 x 2
     Age Gender
   <dbl> <chr> 
 1    13 žena  
 2    13 žena  
 3    14 muž   
 4    14 muž   
 5    15 muž   
 6    15 muž   
 7    15 muž   
 8    15 žena  
 9    15 žena  
10    15 žena  
# ... with 16 more rows

Předchozí skript nejdříve vpouští databázi Katan pomocí trubky do příkazu select(), který ponechá pouze proměnné Věk a Pohlaví. Ty následně pošle do příkazu filtr(), jenž z nich vybere pouze ty řádky, u nichž je věk nižší než 18 let. V závěru ještě dojde k přejmenování proměnných Věk a Pohlaví na Age a Gender. Výsledná databáze se uloží pod názvem Katan2.

Bez trubky bychom výše uvedený příkaz napsali následovně.

# 1. verze (zkrácená)
Katan2 <- rename((filter(select(Katan, Věk, Pohlaví), Věk < 18)), 
                 "Age" = Věk, "Gender" = Pohlaví)
# Všimněte si, že jednotlivé příkazy zapisujeme v opačném pořadí 
# než u předchozího skriptu. Je to obdobné jako při běžné práci
# se závorkami, např. (3 + (1 - (1 - 2)), u níž také budeme řešit 
# závorky směrem od středu ven a nikoliv opačně.

# 2. verze (nezkrácená)
Katan2 <- 
  select(Katan, 
         Věk, Pohlaví)
Katan3 <- 
  filter(Katan2, 
         Věk < 18)
Katan4 <-
  rename(Katan3, 
         "Age" = Věk, "Gender" = Pohlaví)
# Veškeré databáze by se mohli samozřejmě pojmenovat pouze jako Katan,
# pro větší přehlednost však přidáváme k jednotlivým verzím čísla.
# A tibble: 26 x 2
     Age Gender
   <dbl> <chr> 
 1    13 žena  
 2    13 žena  
 3    14 muž   
 4    14 muž   
 5    15 muž   
 6    15 muž   
 7    15 muž   
 8    15 žena  
 9    15 žena  
10    15 žena  
# ... with 16 more rows

Primárním úkolem trubky je zlepšení čitelnosti kódu, jelikož jednotlivé příkazy s její pomocí můžeme zapisovat v jejich logickém pořadí. Pojďme se proto v následující části této kapitoly seznámit s dalšími příkazy dplyru, u nichž nám trubky plně odkryjí své kouzlo. Přesuňme se tudíž jako generál Čankajšek na Tchaj-wan, na němž nalezneme další lekci.

Column

Příklady

Příklad 1

S pomocí trubky vytvořte datovou tabulku s názvem Data_z_trubky, která bude obsahovat proměnné Věk, Pohlaví, Vzdělání a Kouření. Názvy těchto proměnných následně přejmenujte na jejich anglické ekvivalenty. V dalších kroku zajistěte, aby v databázi byli zařazeni pouze jedinci ve věku 18 až 26 let (včetně). Na úplný závěr seřaďte hodnoty v proměnných podle věku, pohlaví, vzdělání a kouření v tomto pořadí.

Group_by a summarise

Column

Tchaj-pej: Group_by a summarise

Máte stále v živé paměti příkazy tapply() a aggregate() z Ria de Janeira? Ukažme si nyní v Tchaj-peji, jak lze tyto funkce obejít pomocí příkazů group_by() a summrize(). Přitom si též představíme praktické využití příkazu trubka. Podívejme se na následující příklad. V něm budeme chtít vypočítat průměr, medián, směrodatnou odchylku, minimum a maximum u proměnné Věk, a to vše podle pohlaví.

Katan %>% 
  group_by(Pohlaví) %>%
  summarise(průměr = mean(Věk),
            sd = sd(Věk),
            min = min(Věk),
            max = max(Věk))
# Výsledek nepřiřazujeme žádné databázi, proto píšeme pouze Katan %>%.
# Pokud bychom ho chtěli uložit, stačí uvést např. Data <- Katan %>% ...,
# kde databáze Data vznikne jako data frame.
# A tibble: 2 x 5
  Pohlaví průměr    sd   min   max
  <chr>    <dbl> <dbl> <dbl> <dbl>
1 muž       29.8 12.2     14    75
2 žena      22.3  5.93    13    44

V našem příkazu nejdříve začínáme trubkou, jelikož data z databáze Katan pomyslně přitečou do příkazu group_by(). Samotný příkaz group_by() nic nepočítá. Pouze vnitřně (neviditelně) rozdělí databázi Katan na dvě tabulky, a to podle proměnné Pohlaví. Kdybychom do závorky příkazu group_by() uvedli i další proměnnou, například Klub, group_by() by nám vytvořil čtyři pomyslné tabulky (žena_člen, žena_nečlen, muž_člen a muž_nečlen).

Když už máme data připravena, využijeme znovu operátor trubka, kterým pošleme do summarise() naši upravenou a roztříděnou databázi Katan. V samotném příkazu summarise() uvedeme nejdříve libovolný název nové proměnné a za jejím rovnítkem teprve až samotnou funkci, tak jak už ji známe. Dolarový symbol nepoužíváme. Výsledkem celého skriptu se stane nová tabulka, jež bude obsahovat právě tolik proměnných, jako jich obsahují příkazy group_by() a summarise() dohromady. Počet řádků nové databáze se řídí počtem jednotlivých kombinací, kterých lze díky group_by() dosáhnout. Pokud tedy dělíme naše data pouze podle pohlaví, získáme dva řádky. Pokud je budeme dělit nejen podle pohlaví, ale například i podle proměnné Klub, získáme je čtyři (viz žena_člen, žena_nečlen, muž_člen a muž_nečlen).

Katan %>% 
  group_by(Pohlaví, Klub) %>%
  summarise(průměr = mean(Věk),
            sd = sd(Věk),
            min = min(Věk),
            max = max(Věk))
# A tibble: 4 x 6
# Groups:   Pohlaví [2]
  Pohlaví Klub   průměr    sd   min   max
  <chr>   <chr>   <dbl> <dbl> <dbl> <dbl>
1 muž     člen     22.7  5.64    14    35
2 muž     nečlen   33.9 13.1     14    75
3 žena    člen     21.2  3.97    15    26
4 žena    nečlen   23.1  7.01    13    44

Ukažme si nyní složitější variantu úvodního příkladu. V něm budeme filtrovat data nejen podle pohlaví, ale též podle proměnné Práce. K tomu se u jednotlivých výpočtů průměru, směrodatné odchylky, minima a maxima zaměříme kromě proměnné Věk i na proměnnou Děti.

Katan %>% 
  group_by(Pohlaví, Práce) %>%
  summarise(průměr_Věk = mean(Věk),
            sd_Věk= sd(Věk),
            min_Věk= min(Věk),
            max_Věk= max(Věk),
            průměr_Děti = mean(Děti),
            sd_Děti = sd(Děti),
            min_Děti = min(Děti),
            max_Děti = max(Děti))
# A tibble: 4 x 10
# Groups:   Pohlaví [2]
  Pohlaví Práce   průměr_Věk sd_Věk min_Věk max_Věk průměr_Děti sd_Děti min_Děti
  <chr>   <chr>        <dbl>  <dbl>   <dbl>   <dbl>       <dbl>   <dbl>    <dbl>
1 muž     neprac~       19.8   2.98      14      25      0        0            0
2 muž     pracuje       36.5  11.4       23      75      1.52     1.06         0
3 žena    neprac~       19.1   3.09      13      25      0.0278   0.167        0
4 žena    pracuje       27.5   5.83      24      44      0.0909   0.426        0
# ... with 1 more variable: max_Děti <dbl>

Jak je vidět, není příliš praktické vypisovat jednotlivé statistické funkce a proměnné zvlášť pro každý výpočet. Proto se nyní podívejme na poněkud odlišný zápis pomocí funkce summarise_each(), který nám umožní najednou vypsat nejenom veškeré funkce, které budeme chtít použít (průměr, směrodatnou odchylku, minimum a maximum), ale i všechny proměnné (Věk a Děti), pro něž budeme chtít výpočty provést.

Katan %>%
  group_by(Pohlaví, Práce) %>%
  summarise_each(funs(mean, sd, min, max), Věk, Děti)
# A tibble: 4 x 10
# Groups:   Pohlaví [2]
  Pohlaví Práce     Věk_mean Děti_mean Věk_sd Děti_sd Věk_min Děti_min Věk_max
  <chr>   <chr>        <dbl>     <dbl>  <dbl>   <dbl>   <dbl>    <dbl>   <dbl>
1 muž     nepracuje     19.8    0        2.98   0          14        0      25
2 muž     pracuje       36.5    1.52    11.4    1.06       23        0      75
3 žena    nepracuje     19.1    0.0278   3.09   0.167      13        0      25
4 žena    pracuje       27.5    0.0909   5.83   0.426      24        0      44
# ... with 1 more variable: Děti_max <dbl>

Výše uvedený zápis je již mnohem stručnější a elegantnější. Problém však nastane, pokud nám v databázi budou chybět hodnoty. V takovém případě by se nám totiž ozval error. Jak jej odstranit? Pokud bychom chtěli vypočítat pouze průměr u proměnné Věk, volili bychom tento známý příkaz.

mean(Katan$Věk, na.rm = TRUE)
[1] 27.64

Možná by Vás proto napadlo předchozí skript přepsat do následující podoby.

Katan %>%
  group_by(Pohlaví, Práce) %>%
  summarise_each(funs(mean(na.rm = TRUE), 
                      sd(na.rm = TRUE), 
                      min(na.rm = TRUE), 
                      max(na.rm = TRUE)), 
                      Věk, Děti)

Takovýto skript však nebude fungovat kvůli problému s trubkou. Příkazy mean(), sd(), min() a max() totiž nejsou příkazy z dplyru. Pokud tak používáme trubku, musíme tyto příkazy upravit do následující podoby.

Katan$Věk %>%
  mean(., na.rm = TRUE)
[1] 27.64

Všimněte si prosím tečky, která nám říká, na kterou pozici mají data z trubky přitéct. V našem případě se jedná o první pozici za závorkou (viz mean(Katan$Vek, na.rm = TRUE)). Tečka není nutná pouze tehdy, kdy je závorka prázdná, jako v následujícím příkazu či jedná-li se o příkaz z dplyru (např. filter(), select() atd.) nebo dalších balíčků (ggplot2, mapy v leafletu se kterými se seznámíme v příští kapitole).

Katan$Věk %>%
    mean()

# respektive
Katan %>%  
  filter(Věk <= 25) 

Na druhou stranu i s tečkou budou příkazy bez problému fungovat.

Katan$Věk %>%
    mean(.)

# respektive
Katan %>%  
  filter(., Věk <= 25) 

Výsledný skript našeho původního příkladu bude proto vypadat následovně.

Katan %>%
  group_by(Pohlaví, Práce) %>%
  summarise_each(funs(mean(., na.rm = TRUE),
                      sd(., na.rm = TRUE),
                      min(., na.rm = TRUE),
                      max(., na.rm = TRUE)),
                      Věk, Děti)
# A tibble: 4 x 10
# Groups:   Pohlaví [2]
  Pohlaví Práce     Věk_mean Děti_mean Věk_sd Děti_sd Věk_min Děti_min Věk_max
  <chr>   <chr>        <dbl>     <dbl>  <dbl>   <dbl>   <dbl>    <dbl>   <dbl>
1 muž     nepracuje     19.8    0        2.98   0          14        0      25
2 muž     pracuje       36.5    1.52    11.4    1.06       23        0      75
3 žena    nepracuje     19.1    0.0278   3.09   0.167      13        0      25
4 žena    pracuje       27.5    0.0909   5.83   0.426      24        0      44
# ... with 1 more variable: Děti_max <dbl>

Ponechme na chvíli funkci summarise_each() stranou a podívejme se na další úkol. V něm nás nebudou zajímat informace získané pomocí mean(), sd(), max() či min(), jelikož se budeme zabývat prostou četností jevů. Chceme-li například zjistit, kolik máme můžu a žen v databázi, lze využít jednoduchou funkci table(Katan$Pohlaví). Co když ale budeme chtít zjistit něco složitějšího? Představte si například, že máte za cíl vyzkoumat, jaký je procentuální podíl mužů a žen podle následujících věkových skupin (teenager do 18 let, dospělý od 18 do 26 let, dospělý od 26 do 65 let a důchodce od 65 let)?

Katan2 <- Katan %>%
    mutate(VěkSkupiny = cut(Věk,
    breaks = c(0, 18, 26, 65, 150),
    right = FALSE,
    labels = c("teenager do 18 let", "dospělý od 18 do 26 let",
               "dospělý od 26 do 65 let", "důchodce od 65 let"))) %>%
    group_by(Pohlaví, VěkSkupiny) %>%
    summarise(
      Četnost_abs = n(), 
      Četnost_rel = (n()/nrow(Katan))*100)
# A tibble: 7 x 4
# Groups:   Pohlaví [2]
  Pohlaví VěkSkupiny              Četnost_abs Četnost_rel
  <chr>   <fct>                         <int>       <dbl>
1 muž     teenager do 18 let               16         8  
2 muž     dospělý od 18 do 26 let          47        23.5
3 muž     dospělý od 26 do 65 let          75        37.5
4 muž     důchodce od 65 let                4         2  
5 žena    teenager do 18 let               10         5  
6 žena    dospělý od 18 do 26 let          38        19  
7 žena    dospělý od 26 do 65 let          10         5  

První část skriptu se zabývá vytvořením nové proměnné VěkSkupiny za přispění funkce cut(). Výsledná proměnná je připojena ke stávající databázi Katan díky mutate(). Ve druhé části skriptu group_by() rozdělí naši tabulku na pomyslných osm dílů podle proměnných Pohlaví a VěkSkupiny (2 pohlaví x 4 věkové skupiny = 8 variant). Takto rozdělená tabulka je pomocí trubky převedena do funkce summarise(), u které nejdříve vypočítáme absolutní četnost n() a poté i relativní četnost (n()/nrow(Katan))*100. Výslednou tabulku převedeme do nově vzniklého data frame s názvem Katan2.

Máte pochybnosti o tom, zdali příkaz n() funguje správně a chtěli byste ho konfrontovat s příkazem table()? Žádný problém. Podívejme se na následující srovnání.

# přístup dplyr
Katan2 <- Katan %>%
    mutate(VěkSkupiny = cut(Věk,
    breaks = c(0, 18, 26, 65, 150),
    right = FALSE,
    labels = c("teenager do 18 let", "dospělý od 18 do 26 let",
               "dospělý od 26 do 65 let", "důchodce od 65 let"))) %>%
    group_by(Pohlaví, VěkSkupiny) %>%
    summarise(
      Četnost_abs = n())

# přístup table()
Katan2 <- Katan %>%
    mutate(VěkSkupiny = cut(Věk,
    breaks = c(0, 18, 26, 65, 150),
    right = FALSE,
    labels = c("teenager do 18 let", "dospělý od 18 do 26 let",
               "dospělý od 26 do 65 let", "důchodce od 65 let")))
table(Katan2$Pohlaví, Katan2$VěkSkupiny)
[1] "Přístup dplyr"
# A tibble: 7 x 3
# Groups:   Pohlaví [2]
  Pohlaví VěkSkupiny              Četnost_abs
  <chr>   <fct>                         <int>
1 muž     teenager do 18 let               16
2 muž     dospělý od 18 do 26 let          47
3 muž     dospělý od 26 do 65 let          75
4 muž     důchodce od 65 let                4
5 žena    teenager do 18 let               10
6 žena    dospělý od 18 do 26 let          38
7 žena    dospělý od 26 do 65 let          10
[1] "Přístup table"
      
       teenager do 18 let dospělý od 18 do 26 let dospělý od 26 do 65 let
  muž                  16                      47                      75
  žena                 10                      38                      10
      
       důchodce od 65 let
  muž                   4
  žena                  0

Výhodou přístupu z dplyr je zejména to, že výsledek obdržíme v přehledném formátu data frame, se kterým lze následně bez problémů pracovat.

Abychom si vyzkoušeli group_by() a summarise() ještě trochu více do hloubky, nainstalujme si nyní balíček hflights, který obsahuje data z letecké přepravy. Ten stáhneme do R tak, jako by se jednalo o obyčejný balíček, podobně jako dplyr.

install.packages("hflights")
library(hflights)
flights <- hflights
# Databázi přejmenujeme na flights, tímto krokem ji navíc dostaneme
# do pravého horního panelu.

Máme-li už databázi staženou, podívejme se se na následující příklad. V něm budeme chtít zjistit počty zrušených a nezrušených letů podle letiště.

flights %>%
group_by(Dest) %>%
summarise(Cancelled = sum(Cancelled), 
          Not_Cancelled = n()-sum(Cancelled)) 
# proměnná Dest označuje kód cílového letiště 
# proměnná Cancelled obsahuje nuly a jedničky (zrušený let)
# A tibble: 116 x 3
   Dest  Cancelled Not_Cancelled
   <chr>     <int>         <int>
 1 ABQ          25          2787
 2 AEX          12           712
 3 AGS           0             1
 4 AMA          32          1265
 5 ANC           0           125
 6 ASE           5           120
 7 ATL         141          7745
 8 AUS          27          4995
 9 AVL           3           347
10 BFL           1           503
# ... with 106 more rows

Výše uvedený příklad lze vyřešit i bez summarise() a to díky table(). Všimněte si struktury následujícího skriptu. Nejdříve vybíráme proměnnou, podle které mají být data rozřazena. V našem případě se jedná o letecké destinace (proměnná Dest). V dalším kroku pomocí příkazu select() vybíráme jedinou proměnnou a to Cancelled, která zobrazuje jedničku pro zrušený let a nulu pro ten odbavený. Výsledný příkaz končí prázdnou závorkou příkazu table(), do níž přitečou data pomocí trubky.

flights %>%
  group_by(Dest) %>%
  select(Cancelled) %>%
  table() 
     Cancelled
Dest     0    1
  ABQ 2787   25
  AEX  712   12
  AGS    1    0
  AMA 1265   32
  ANC  125    0
  ASE  120    5
  ATL 7745  141
  AUS 4995   27
  AVL  347    3
  BFL  503    1
  BHM 2697   39
  BKG  108    2
  BNA 3451   30
  BOS 1724   28
  BPT    3    0
  BRO 1665   27
  BTR 1733   29
  BWI 2527   24
  CAE  547   14
  CID  408    2
  CLE 2132    8
  CLT 4671   64
  CMH 1334   14
  COS 1637   20
  CRP 4720   93
  CRW  350    7
  CVG 1518   17
  DAL 9378  442
  DAY  446    5
  DCA 2664   35
  DEN 5892   28
  DFW 6500  153
  DSM  635   12
  DTW 2568   33
  ECP  727    2
  EGE  108    2
  ELP 3012   24
  EWR 4244   70
  FLL 2455    7
  GJT  401    2
  GPT 1586   32
  GRK   40    2
  GRR  672    5
  GSO  624    6
  GSP 1116    7
  GUC   86    0
  HDN  109    1
  HNL  401    1
  HOB  299   10
  HRL 3881  102
  HSV  911   12
  CHS 1191    9
  IAD 1958   22
  ICT 1484   33
  IND 1726   24
  JAN 1984   27
  JAX 2123   12
  JFK  677   18
  LAS 4067   15
  LAX 6031   33
  LBB 1309   24
  LEX  578    6
  LFT 2257   56
  LGA 2681   49
  LCH  352   12
  LIT 1553   26
  LRD 1168   20
  MAF 2263   43
  MCI 3133   41
  MCO 3671   16
  MDW 2072   22
  MEM 2352   47
  MFE 1116   12
  MIA 2439   24
  MKE 1568   20
  MLU  288    4
  MOB 1641   33
  MSP 1986   24
  MSY 6783   40
  MTJ  163    1
  OAK  685    5
  OKC 3114   56
  OMA 2025   19
  ONT  950    2
  ORD 5649   99
  ORF  711    6
  PBI 1242   11
  PDX 1232    3
  PHL 2340   27
  PHX 5067   29
  PIT 1652   12
  PNS 1516   23
  PSP  106    0
  RDU 1727   13
  RIC  893    7
  RNO  243    0
  RSW  941    7
  SAN 2924   12
  SAT 4853   40
  SAV  855    8
  SDF 1269   10
  SEA 2611    4
  SFO 2804   14
  SHV  778    9
  SJC  884    1
  SJU  389    2
  SLC 2024    9
  SMF 1011    3
  SNA 1651   10
  STL 2479   30
  TPA 3074   11
  TUL 2870   54
  TUS 1550   15
  TYS 1202    8
  VPS  870   10
  XNA 1138   34

A co takhle použít pouze příkaz table()? Jistě, i to je možnost. Ale uznejte sami, nevypadal ten předchozí příkaz poněkud sofistikovaněji?

table(flights$Dest, flights$Cancelled)
     
         0    1
  ABQ 2787   25
  AEX  712   12
  AGS    1    0
  AMA 1265   32
  ANC  125    0
  ASE  120    5
  ATL 7745  141
  AUS 4995   27
  AVL  347    3
  BFL  503    1
  BHM 2697   39
  BKG  108    2
  BNA 3451   30
  BOS 1724   28
  BPT    3    0
  BRO 1665   27
  BTR 1733   29
  BWI 2527   24
  CAE  547   14
  CID  408    2
  CLE 2132    8
  CLT 4671   64
  CMH 1334   14
  COS 1637   20
  CRP 4720   93
  CRW  350    7
  CVG 1518   17
  DAL 9378  442
  DAY  446    5
  DCA 2664   35
  DEN 5892   28
  DFW 6500  153
  DSM  635   12
  DTW 2568   33
  ECP  727    2
  EGE  108    2
  ELP 3012   24
  EWR 4244   70
  FLL 2455    7
  GJT  401    2
  GPT 1586   32
  GRK   40    2
  GRR  672    5
  GSO  624    6
  GSP 1116    7
  GUC   86    0
  HDN  109    1
  HNL  401    1
  HOB  299   10
  HRL 3881  102
  HSV  911   12
  CHS 1191    9
  IAD 1958   22
  ICT 1484   33
  IND 1726   24
  JAN 1984   27
  JAX 2123   12
  JFK  677   18
  LAS 4067   15
  LAX 6031   33
  LBB 1309   24
  LEX  578    6
  LFT 2257   56
  LGA 2681   49
  LCH  352   12
  LIT 1553   26
  LRD 1168   20
  MAF 2263   43
  MCI 3133   41
  MCO 3671   16
  MDW 2072   22
  MEM 2352   47
  MFE 1116   12
  MIA 2439   24
  MKE 1568   20
  MLU  288    4
  MOB 1641   33
  MSP 1986   24
  MSY 6783   40
  MTJ  163    1
  OAK  685    5
  OKC 3114   56
  OMA 2025   19
  ONT  950    2
  ORD 5649   99
  ORF  711    6
  PBI 1242   11
  PDX 1232    3
  PHL 2340   27
  PHX 5067   29
  PIT 1652   12
  PNS 1516   23
  PSP  106    0
  RDU 1727   13
  RIC  893    7
  RNO  243    0
  RSW  941    7
  SAN 2924   12
  SAT 4853   40
  SAV  855    8
  SDF 1269   10
  SEA 2611    4
  SFO 2804   14
  SHV  778    9
  SJC  884    1
  SJU  389    2
  SLC 2024    9
  SMF 1011    3
  SNA 1651   10
  STL 2479   30
  TPA 3074   11
  TUL 2870   54
  TUS 1550   15
  TYS 1202    8
  VPS  870   10
  XNA 1138   34

Zdají se vám výše uvedené tři skripty naprosto srovnatelné a zaměnitelné? Je tomu tak pouze do určité míry. Rozdíly totiž nalezneme ve výsledných datových strukturách. Podívejme se proto na následující rekapitulaci. V té výsledky předchozích skriptů uložíme do tří proměnných Data1, Data2 a Data3.

# přístup dplyr
Data1 <- flights %>%
group_by(Dest) %>%
summarise(Cancelled = sum(Cancelled), 
          Not_Cancelled = n()-sum(Cancelled)) 

# přístup kombinace dplyr a table()
Data2 <- flights %>%
  group_by(Dest) %>%
  select(Cancelled) %>%
  table() 

# přístup table()
Data3 <- table(hflights$Dest, hflights$Cancelled)
[1] "tbl_df"     "tbl"        "data.frame"
[1] "table"
[1] "table"

Poslední dva skripty za použití funkce table(), navzdory jejich jednoduchosti, obsahují jedno omezení. Výsledný formát dat, chceme-li jej uchovat a dále s ním pracovat, nebude uložen v datové struktuře data frame. Chceme-li s ním proto nakládat jako s běžnou datovou tabulkou, musíme jej převést na data frame pomocí příkazu as.data.frame().

# přístup kombinace dplyr a table()
Data2 <- flights %>%
  group_by(Dest) %>%
  select(Cancelled) %>%
  table() 
Data2 <- as.data.frame(Data2)
class(Data2)

# přístup table()
Data3 <- table(hflights$Dest, hflights$Cancelled)
Data3 <- as.data.frame(Data3)
class(Data3)
[1] "data.frame"
[1] "data.frame"

To nám však nemusí stačit, jelikož formát výsledné tabulky bude při použití funkce table() stále odlišný od té podoby, které jsme dosáhli za pomoci příkazu summarise(). Zdali to bude pro vás výhoda či nevýhoda musíte posoudit již vy sami ve vaší konkrétní situaci (viz následující obrázek).

Posuňme se v závěru této lekce ještě trochu kupředu. Funkci group_by() lze použít i ve spojitosti s dalšími příkazy z balíčku dplyr. Ukažme si je na následujícím příkladu. V něm budeme chtít zjistit, ve které tři dny v roce měli jednotliví dopravci nejdelší zpoždění.

flights %>%
    group_by(UniqueCarrier) %>%
    select(Month, DayofMonth, DepDelay) %>%
    top_n(3, DepDelay) %>%
    arrange(UniqueCarrier, desc(DepDelay))
# UniqueCarrier: kód dopravce
# DepDelay: zpoždění odletu v minutách
# A tibble: 45 x 4
# Groups:   UniqueCarrier [15]
   UniqueCarrier Month DayofMonth DepDelay
   <chr>         <int>      <int>    <int>
 1 AA               12         12      970
 2 AA               11         19      677
 3 AA               12         22      653
 4 AS                2         28      172
 5 AS                7          6      138
 6 AS                4          8      102
 7 B6               10         29      310
 8 B6                8         19      283
 9 B6                3         10      278
10 CO                8          1      981
# ... with 35 more rows

V první části skriptu pouštíme pomocí trubky data z databáze flights do příkazu group_by(), který nám údaje roztřídí podle dopravců. Následující příkaz select() nám z databáze vytřídí přebytečné proměnné a zanechá nám pouze měsíc, den, zpoždění (DepDelay) a označení pro dopravce (proměnná UniqueCarrier), které zůstane automaticky vzhledem k příkazu group_by(). Následující příkaz top_n(3, DepDelay) zobrazí tři nejvyšší hodnoty podle proměnné DepDelay. Poslední příkaz arrange() zařídí, aby byla veškerá výsledná data seřazena podle dopravce (UniqueCarrier) a následně dle zpoždění (DepDelay) v sestupném pořadí.

Libí se vám zkratky místo skutečných názvů leteckých společností? Mně tedy vůbec ne. Z tohoto důvodu si stáhněte databázi Letecke_spolecnosti, která obsahuje dva sloupce: název letecké společnosti (proměnná Dopravce) a zkratku, pod kterou ji naleznete na letištních tabulích (proměnná Zkratka). Naším úkolem se stane přepsat skript tak, aby jeho výsledkem byla databáze Zpoždění, která bude zobrazovat skutečné názvy aerolinek.

Letecke_spolecnosti <- read_excel("C:/Users/.../Letecke_spolecnosti.xlsx") 
Letecke_spolecnosti$UniqueCarrier <- Letecke_spolecnosti$Zkratka
# Tento příkaz tu je zde kvůli příkazu left_join(), tak abychom 
# sjednotili názvy proměnných Zkratka a UniqueCarrier.

Zpoždění <- flights %>%
  group_by(UniqueCarrier) %>%
  select(Month, DayofMonth, DepDelay) %>%
  top_n(3, DepDelay) %>%
  left_join(., Letecke_spolecnosti, by = "UniqueCarrier") %>%
  select(Dopravce, Month, DayofMonth, DepDelay) %>%
  rename("Zkratka" = UniqueCarrier, "Měsíc" = Month, 
         "Den" = DayofMonth, "Zpoždění" = DepDelay)  %>%
  arrange(desc(Zpoždění))
# A tibble: 45 x 5
# Groups:   Zkratka [15]
   Zkratka Dopravce             Měsíc   Den Zpoždění
   <chr>   <chr>                <int> <int>    <int>
 1 CO      Continental Airlines     8     1      981
 2 AA      American Airlines       12    12      970
 3 MQ      Envoy Air               11     8      931
 4 UA      United Airlines          6    21      869
 5 MQ      Envoy Air                6     9      814
 6 MQ      Envoy Air                5    20      803
 7 CO      Continental Airlines     1    20      780
 8 CO      Continental Airlines     6    22      758
 9 DL      Delta                   10    25      730
10 AA      American Airlines       11    19      677
# ... with 35 more rows

Na úplný závěr této lekce nás bude ještě zajímat celkový počet letů za každý měsíc včetně procentuální (i absolutní) změny oproti předchozímu měsíci.

flights %>%
  group_by(Month) %>%
  summarise(Count_Flights = n()) %>%
  mutate(abs_change = Count_Flights-lag(Count_Flights)) %>%
  mutate(rel_change = (Count_Flights-lag(Count_Flights))/lag(Count_Flights)*100)
  # Procentuální změny (i ty absolutní) vypočítáme pomocí funkce lag(), 
  # která posune hodnoty v proměnné o jednu pozici při zanechání délky
  # proměnné.
  # Př. x <- c(1, 2, 3, 4, 5) => lag(x) => [1] NA  1  2  3  4

  # Není vám zcela jasný rozdíl mezi summarise() a mutate()?
  # Pokračujte do další lekce.
# A tibble: 12 x 4
   Month Count_Flights abs_change rel_change
   <int>         <int>      <int>      <dbl>
 1     1         18910         NA      NA   
 2     2         17128      -1782      -9.42
 3     3         19470       2342      13.7 
 4     4         18593       -877      -4.50
 5     5         19172        579       3.11
 6     6         19600        428       2.23
 7     7         20548        948       4.84
 8     8         20176       -372      -1.81
 9     9         18065      -2111     -10.5 
10    10         18696        631       3.49
11    11         18021       -675      -3.61
12    12         19117       1096       6.08

Výše uvedený skript začínáme obligátním průtokem dat pomocí trubky do příkazu group_by(), který nám rozdělí data do jednotlivých měsíců. Poté následuje příkaz summarise(), který si klade za cíl spočítat počty letů podle jednotlivých měsíců. Výsledkem se stanou dva sloupce proměnných, které vidíte výše (proměnné Month a Count_Flights). Tímto ale skript nekončí, jelikož pokračuje dvěma příkazy mutate(), které přidávají další dva sloupce. První z příkazů mutate() si klade za cíl vytvořit proměnnou abs_change, která bude sledovat rozdíl mezi počty odbavených letů mezi jednotlivými měsíci v absolutních číslech (např. rozdíl mezi únorem a lednem, jehož hodnota bude uvedena v řádku za únor). Druhý příkaz mutate() následně tytéž údaje převede na procenta (např. ((únor - leden) / leden) * 100).

Ačkoliv byla nynější lekce v hlavním městě Čínské republiky (tak totiž zní oficiální název Tchaj-wanu) poněkud obsáhlá, neznamená to, že s příkazy group_by() a summarise() v této kapitole končíme. Věnovat se jim totiž budeme i v následujících dvou lekcích, které nás přesunou zpět k balíčku ggplot2.

Column

Příklady

Příklad 2

Zjistěte v následujících věkových skupinách (teenager do 18 let, dospělý od 18 do 26 let, dospělý od 26 do 35 let, dospělý od 35 do 65 let, dospělý 65 let a více) zastoupení mužů a žen a jejich průměrný počet partií na osobu. Ve skriptu využijte příkaz trubka.

Příklad 3

Zjistěte průměr, medián a směrodatnou odchylku u proměnných Partie a Věk. Hodnoty určete pro skupiny rozřazené dle proměnných Vzdělání a Pohlaví (tj. ZŠ - muž, ZŠ - žena, SŠ - muž, SŠ - žena atd.). Ve skriptu využijte příkaz trubka.

Příklad 4

V databázi hflights zjistěte největší zpoždění za jednotlivé měsíce v roce. Ve skriptu využijte příkaz trubka.

Line charts 2

Column

Hongkong: Liniové grafy 2

Hongkong nás přivádí zpět k balíčku ggplot2, ve kterém si v liniových grafech vyzkoušíme použití trubky, group_by() a summarise(). Na pomoc si též přivoláme databázi Praha_Ostrava, která shromažďuje údaje o železničním spojení mezi Prahou a Ostravou mezi léty 2010 až 2018. S databází Katan v této a následující lekci nebudeme operovat z toho důvodu, jelikož vám chci ukázat práci s časem.

Seznamme se s proměnnými databáze Praha_Ostrava.

# Rok: značí rok platnosti linky v jízdním řádu

# Dopravce: značí konkrétního provozovatele linky (ČD: značí spoje ČD IC/EC/Ex, 
#           ČD_SC: značí spoje ČD SC Pendolino, RJ: značí RegioJet, 
#           LE: značí Leo Express)

# Odjezd: značí odjezd vlaku ze zastávky Praha, hl.n.

# Příjezd: značí příjezd vlaku do zastávky Ostrava, hl.n.

# Čas: značí jízdní dobu vlaku

# Frekvence: frekvence označuje jednotlivé dny v týdnu 
#            (1 = pondělí,..., 7 = neděle), ve kterých je daný spoj vypravován, 
#            číslo 1234567 můžeme tedy interpretovat tak, že vlak jezdí po celý 
#            týden bez výjimky (státní svátky byly zanedbány)

# Zastávky: značí celkový počet zastávek vlaku (včetně výchozí a cílové stanice)

# Praha, hl.n. ~ Ostrava, hl.n.: proměnná nabývá hodnoty 1...vlak v dané stanici 
#                                zastavuje a 0...vlak danou stanicí pouze projíždí

Úvod máme za sebou, podívejme se na první příklad. V něm nás bude zajímat, kterak vypadal kumulativní vývoj počtu spojů mezi Prahou a Ostravou mezi léty 2010 až 2018. Vývoj bude zobrazen v procentech a rok 2010 bude hrát roli počátečního období, vůči kterému budeme změny v následujících letech porovnávat.

library(dplyr)
library(ggplot2)    
library(ggthemes)   

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)

Data <- Praha_Ostrava %>%
  group_by(Rok) %>%
  summarise(Součet = sum(Pravidelnost)) %>%
  mutate(Kumul = round((Součet/Součet[1]-1), 3))

ggplot(Data, 
  aes(x = Rok, y = Kumul)) + 
  geom_line(colour= "#004990", size = 2) +
  ggtitle(expression(atop(bold("Kumulativní vývoj počtu spojů"),
                          atop("mezi léty 2010 až 2018"), ""))) +
  theme_economist() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    # axis.title.x definuje grafickou podobu názvu osy x.
    # My však vzhledem k příkazu labs(x = "", y = "") název nedefinujeme,
    # proto je tento příkaz axis.title.x v zásadě zbytečný, obdobně i 
    # axis.title.y.
    axis.title.y = element_text(color = "black", size = 12),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    legend.title = element_blank())

Na železnici, dějou se věci, na dráze jsou zaměstnáni švarní mládenci. Alespoň tak o tom vypráví píseň s názvem Šel nádražák na mlíčí z pera Járy Cimrmana. Tuto skutečnost potvrzuje i výše uvedený graf, který deklaruje, že se například v roce 2013 zvýšil počet spojů mezi Prahou a Ostravou o více než 80 % v porovnání s rokem 2010. Tento rok je zajímavý zejména z toho důvodu, jelikož v něm na trati Praha-Ostrava začal působit Leoš Novotný a jeho dálkové tramvaje pod značkou Leo Express. Jen pro upřesnění, Radim Jančura s RegioJetem vstoupil na trh již v září roku 2011. Konkurence na železnici proto bezpochyby zapříčinila výrazný nárůst počtu spojů mezi českou a moravskoslezskou metropolí.

Graf našeho prvního příkladu se nesl vcelku v jednoznačném duchu. Co však jeho skript? Je ten dostatečně jasný a srozumitelný? V případě, že nikoliv, jistě uvítáte následující rozbor, ve kterém si vše vysvětlíme. První, co musíme při tvorbě grafu učinit, je nahrát do RStudia veškeré potřebné balíčky. Budeme potřebovat dplyr na práci s data frame a dále ggplot2 a ggthemes na tvorbu samotného grafu.

library(dplyr)
library(ggplot2)    
library(ggthemes)   

Krok číslo dvě je nejdůležitější. Abychom mohli vytvořit graf kumulativního vývoje počtu spojů, musíme k němu vytvořit odpovídající datovou tabulku, která bude tyto hodnoty zobrazovat. Takovouto tabulku přímo v databázi Praha_Ostrava nenalezneme, proto si ji musíme vytvořit.

Nejdříve musí vzniknout nová proměnná, která bude zobrazovat, kolikrát byl daný vlak za týden vypraven. V databázi Praha_Ostrava nalezneme proměnnou s názvem Frekvence, která tyto údaje do jisté míry obsahuje. V případě, že je v ní například uvedeno 12345, znamená to, že daný vlak jel v týdnu pětkrát. Číslo pět je právě tou hodnotou, kterou my potřebujeme přenést do nové proměnné. Jak ale tuto proměnnou stvoříme? K tomu nám poslouží příkaz nchar(), který sčítá počty znaků v daném pozorování (vzpomeňte si na databázi specdata ze čtvrté kapitoly). Číslo 12345 obsahuje pět znaků, proto se výsledkem stane pětka, respektive nová proměnná Pravidelnost, kterou připojíme k databázi Praha_Ostrava.

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)    
Praha_Ostrava[ , c(1, 2, 6, 24)]
# Aby se nám výsledná databáze vešla na obrazovku, 
# omezíme výběr pouze na čtyři proměnné.
# A tibble: 323 x 4
     Rok Dopravce Frekvence Pravidelnost
   <dbl> <chr>        <dbl>        <int>
 1  2010 ČD_SC       123457            6
 2  2010 ČD_SC      1234567            7
 3  2010 ČD_SC      1234567            7
 4  2010 ČD_SC            5            1
 5  2010 ČD_SC      1234567            7
 6  2010 ČD_SC       123457            6
 7  2010 ČD_SC            7            1
 8  2010 ČD_SC        12345            5
 9  2010 ČD_SC      1234567            7
10  2010 ČD               5            1
# ... with 313 more rows

Nyní jsme již připraveni vytvořit samotnou datovou tabulku kumulativního vývoje počtu spojů. Nejdříve trubkou pošleme data z databáze Praha_Ostrava do group_by(), který nám je pomyslně rozčlení dle jednotlivých let. Dalším krokem se stane součet hodnot z proměnné Pravidelnost za jednotlivé roky zvlášť (což nám zařídí právě group_by()). Posledním krokem bude výpočet procentuálních změn vůči předchozímu období (roku), jenž uvidíme v nově vytvořené proměnné Kumul v rámci data frame Data (Součet/Součet[1]-1). Jedničku odečítáme z toho důvodu, jelikož chceme na ose y začínat od nuly, a nikoliv od jedné (respektive ze 100 %). Výsledek na závěr ještě zaokrouhlíme na tři desetinná místa.

Data <-  Praha_Ostrava %>%
  group_by(Rok) %>%
  summarise(Součet = sum(Pravidelnost)) %>%
  mutate(Kumul = round((Součet/Součet[1]-1), 3))
# A tibble: 9 x 3
    Rok Součet Kumul
  <dbl>  <int> <dbl>
1  2010    140 0    
2  2011    195 0.393
3  2012    202 0.443
4  2013    259 0.85 
5  2014    252 0.8  
6  2015    234 0.671
7  2016    245 0.75 
8  2017    247 0.764
9  2018    238 0.7  

Některým z vás v této chvíli jistě nebude zcela jasný rozdíl mezi příkazy summarise() a mutate(). Struktura obou těchto příkazů totiž vypadá na první pohled velice podobně, jelikož oba tyto příkazy používáme při tvorbě nové proměnné. Příkazy nicméně zaměnitelné nejsou. summarise() totiž vytváří novou proměnnou (chcete-li nový sloupec) data frame a přitom vynechává všechny ostatní proměnné, kterou jsou ve zdrojové databázi přítomny. Jinými slovy, při tvorbě nové proměnné s názvem Součet s pomocí příkazu summarise() vynecháme veškeré proměnné databáze Praha_Ostrava a ponecháme pouze Rok (viz příkaz group_by()) a právě nově vytvořenou proměnnou Součet.

Pokud bychom příkaz summarise() vyměnili za mutate(), získali bychom též proměnnou Součet, ta by se ale stala součástí původní databáze Praha_Ostrava. Výsledná hodnota z proměnné Součet by se ovšem propsala do všech řádků, ve kterých je daný rok uveden. Ostatně podívejte se sami, jak by daný výsledek vypadal. Stačí se zaměřit na hodnotu 140, kterou nyní vidíme u všech vlaků vyjíždějících v roce 2010. Vzhledem k tomu, že jsme použili mutate() místo summarise(), bude mít výsledná databáze Data stejný počet řádků jako ta původní. U summarise() má naopak výsledná databáze takový počet řádků, jako je unikátních kombinací uvnitř group_by().

Data <- Praha_Ostrava %>%
  group_by(Rok) %>%
  mutate(Součet = sum(Pravidelnost))
Data[ , c(1, 2, 3, 24, 25)]
# Aby se nám výsledná databáze vešla na obrazovku, 
# omezíme výběr pouze na pět proměnných.
# A tibble: 323 x 5
# Groups:   Rok [9]
     Rok Dopravce Odjezd              Pravidelnost Součet
   <dbl> <chr>    <dttm>                     <int>  <int>
 1  2010 ČD_SC    1899-12-31 11:26:00            6    140
 2  2010 ČD_SC    1899-12-31 13:26:00            7    140
 3  2010 ČD_SC    1899-12-31 15:26:00            7    140
 4  2010 ČD_SC    1899-12-31 16:26:00            1    140
 5  2010 ČD_SC    1899-12-31 17:26:00            7    140
 6  2010 ČD_SC    1899-12-31 19:26:00            6    140
 7  2010 ČD_SC    1899-12-31 20:26:00            1    140
 8  2010 ČD_SC    1899-12-31 05:26:00            5    140
 9  2010 ČD_SC    1899-12-31 09:26:00            7    140
10  2010 ČD       1899-12-31 13:30:00            1    140
# ... with 313 more rows

Při pohledu na data vás možná zarazí ještě jedna věc a tou je formát času. Proč je zde uveden 31. prosinec roku 1899? Ten je tu z toho důvodu, jelikož data pochází z excelové tabulky a Excel kóduje čas na numerický formát pomocí výchozího data 1. 1. 1990. Při převodu do R se ale toto datum převede na 31. prosinec roku 1899. Tématu času bude věnována pozornost zejména v následující lekci.

Krok číslo tři je nejjednodušší. Spočívá v tvorbě samotného liniového grafu. Vzhledem k tomu, že na y-ové ose chceme vidět procenta, budeme muset využít příkaz scale_y_continuous(labels = scales::percent_format(accuracy = 1)). Výsledné hodnoty na ose budou díky parametru accuracy = 1 bez desetinných míst (accuracy = 0.1 značí jedno desetinné místo, accuracy = 0.01 dvě atd.).

ggplot(Data, 
  aes(x = Rok, y = Kumul)) + 
  geom_line(colour = "#004990", size = 2) +
  ggtitle(expression(atop(bold("Kumulativní vývoj počtu spojů"),
                          atop("mezi léty 2010 až 2018"), ""))) +
  theme_economist() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust=0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    legend.title = element_blank())

První graf máme za sebou, přesuňme se proto ke grafu č. 2. Ten si klade za cíl zobrazit vývoj počtu zastávek podle jednotlivých dopravců na téže trase mezi Prahou a Ostravou v letech 2010 až 2018.

library(dplyr)
library(ggplot2)    
library(ggthemes)   

Data <- Praha_Ostrava %>%
  group_by(Rok, Dopravce) %>%
  summarise_each(funs(median(., na.rm = TRUE)), Zastávky)

ggplot(Data,
  aes(x = Rok, y = Zastávky, colour = Dopravce)) +
  geom_line(size = 2) +
  ggtitle(expression(atop(bold("Vývoj počtu zastávek dopravců"),
                          atop("mezi léty 2010 až 2018"), ""))) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1)) +
  scale_y_continuous(breaks = seq(from = 5, to = 12, by = 1)) +
  theme_economist() +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, 
                              face = "bold", hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    # axis.title.x definuje grafickou podobu názvu osy x.
    # My však vzhledem k příkazu labs(x = "", y = "") název nedefinujeme,
    # proto je tento příkaz axis.title.x v zásadě zbytečný, obdobně i 
    # axis.title.y.
    axis.title.y = element_text(color = "black", size = 12),
    
    axis.text.x = element_text(hjust = 0.5),
    # axis.text.x definuje grafickou podobu hodnot na ose x,
    # zde však pouze zarovnání na střed, které je navíc defaultní,
    # proto je tento řádek též v podstatě zbytečný.
    
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    # fill definuje barvu pozadí v grafu, colour na jeho okraji
    
    legend.title = element_blank()) +
    # před legendou nebude uveden název proměnné, tj. proměnné Dopravce
  
  scale_colour_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino", 
                                "Leo Express", "RegioJet"), 
                     values = c("#004990", "#668fcc", "#141414", "#FBBF20"))
  # Dopravce rozlišujeme podle parametru colour, proto používáme 
  # scale_colour_manual() a nikoliv scale_fill_manual() (viz příkaz aes()).

Výše uvedený skript postupuje obdobně jako ten předchozí s několika drobnými úpravami. První rozdíl nalezneme hned v úvodní části skriptu, ve které tvoříme data frame s názvem Data, který zobrazuje počty zastávek pro jednotlivé dopravce v jednotlivých letech. V něm totiž pracujeme s příkazem median(), do kterého musíme uvést zápis median(., na.rm = TRUE), v němž tečka symbolizuje pozici, do které mají data přitéct pomocí trubky z group_by(Rok, Dopravce).

A proč tu vlastně používáme funkci medián? Zastavovací politika dopravců je taková, že drtivá většina linek téhož dopravce a jednoho typu služby (u ČD rozlišujeme dva druhy) zastavuje až na drobné výjimky pokaždé ve stejné stanici. Naším cílem proto je vyřadit ty linky, které se odchylují od drtivé většiny ostatních. Z tohoto důvodu volíme medián, který vyřadí linky s větším či menším počtem zastávek, než je obvyklé.

Data <- Praha_Ostrava %>%
  group_by(Rok, Dopravce) %>%
  summarise_each(funs(median(., na.rm = TRUE)), Zastávky)
# A tibble: 32 x 3
# Groups:   Rok [9]
     Rok Dopravce Zastávky
   <dbl> <chr>       <dbl>
 1  2010 ČD             10
 2  2010 ČD_SC           5
 3  2011 ČD             10
 4  2011 ČD_SC           5
 5  2011 RJ              9
 6  2012 ČD             10
 7  2012 ČD_SC           5
 8  2012 RJ              9
 9  2013 ČD             10
10  2013 ČD_SC           5
# ... with 22 more rows

Druhý rozdíl se týká samotného grafu. Jelikož pracujeme s různými dopravci, chceme, aby jednotlivé křivky grafu byly zobrazeny ve firemních barvách daného dopravce. K tomu nám poslouží příkaz scale_colour_manual() či scale_color_manual() (není v nich žádný rozdíl), pomocí kterého nejdříve pojmenujeme jednotlivé křivky v legendě (viz labels) a těm následně přidělíme barvy v hexovém formátu.

scale_colour_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino", 
                              "Leo Express", "RegioJet"), 
                    values = c("#004990", "#668fcc", 
                               "#141414", "#FBBF20"))
# V jakém pořadí označit jednotlivé dopravce? Podle abecedy.
# levels(as.factor(Praha_Ostrava$Dopravce)), 
# respektive levels(Praha_Ostrava$Dopravce)
# [1] "ČD"    "ČD_SC" "LE"    "RJ"  

A to je z této lekce vše. Tedy skoro vše. V příkladech na vás totiž čekají dva úkoly, které do hloubky prověří vaše nově nabyté znalosti. Pusťte se do nich.

Column

Příklady

Příklad 5

Vytvořte liniový graf kumulativního vývoje počtu spojů mezi Prahou a Ostravou mezi léty 2010 až 2018 pro veškeré spoje Českých drah. Z tohoto důvodu nezapomeňte, že se jedná nejen o spoje typu ČD IC/EC/Ex (označení ČD v proměnné Dopravce), ale i o spoje ČD SC Pendolino (označení ČD_SC v proměnné Dopravce). V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.

Příklad 6

Vytvořte liniový graf mediánu jízdních dob mezi Prahou a Ostravou mezi léty 2010 až 2018 pro jednotlivé dopravce zvlášť. Rozlišujte prosím mezi spoji typu ČD IC/EC/Ex (označení ČD v proměnné Dopravce) a ČD SC Pendolino (označení ČD_SC v proměnné Dopravce). V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.

Bar charts 2

Column

Hanoj: Sloupcové grafy 2

Stejně jako u liniových grafů, tak i u těch sloupcových nalezne významné uplatnění balíček dplyr, respektive jeho příkazy trubka, group_by() a summarise(). Podívejme se proto na následující příklad, ve kterém budeme jako v minulé lekci pracovat s databází Praha_Ostrava. Naším úkolem se stane vytvořit sloupcový diagram, který bude zobrazovat počty vlakových spojů jedoucích za celý týden mezi Prahou a Ostravou podle jednotlivých let bez ohledu na dopravce. A aby to nebylo tak jednoduché, zobrazíme uprostřed sloupců i samotné číselné hodnoty.

library(dplyr)
library(ggplot2)    
library(ggthemes)   

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)

Data <- Praha_Ostrava %>%
  group_by(Rok) %>%
  summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost) 

ggplot(Data,
  aes(x = Rok, y = Pravidelnost)) + 
  geom_bar(stat = "identity", fill = "#004990") +
  # pomocí fill určíme barvu sloupců
  
  geom_text(aes(y = Pravidelnost, label = Pravidelnost), 
            position =  position_stack(vjust = 0.5),
  # Pomocí vjust určíme vertikální polohu čísel uvnitř sloupců: 
  # 0.5 uprostřed, 1 na vrcholu, 0 dole.
  # Všimněte si podobnosti s hjust, který používáme pro horizontální
  # polohu.
            size = 5, 
            color = "white") +
  ggtitle(expression(atop(bold("Vývoj počtu vypravených spojů"),
                          atop("jedoucích za celý týden bez svátků"), ""))) +
  theme_economist() +
  scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    # pomocí fill definujeme pozadí grafu, pomocí colour jeho okraj
    
    legend.title = element_blank())

Začátek skriptu začínáme nám již známým příkazem nchar(), díky němuž zjistíme u daného řádku (vlaku) počet spojů za jednotlivý týden (ještě před tím nicméně nesmíte zapomenout načíst veškeré potřebné balíčky, pokud je ještě v rámci dané relace načtené nemáte).

library(dplyr)
library(ggplot2)    
library(ggthemes)   

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)

Krok číslo dvě spočívá ve vytvoření datové tabulky, z níž bude náš sloupcový graf čerpat své údaje. Vzhledem k tomu, že chceme sledovat údaje za jednotlivé roky, využijeme příkaz group_by(), který data rozdělí dle proměnné Rok. Příkaz summarise_each() poté sečte počty spojů za jednotlivá léta a vytvoří proměnnou Pravidelnost v rámci data frame Data.

Data <- Praha_Ostrava %>%
  group_by(Rok) %>%
  summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost) 

# V příkazu summarise_each() pracujeme s proměnnou Praha_Ostrava$Pravidelnost,
# výsledná proměnná v databázi Data se bude jmenovat též Pravidelnost,
# respektive Data$Pravidelnost.
# A tibble: 9 x 2
    Rok Pravidelnost
  <dbl>        <int>
1  2010          140
2  2011          195
3  2012          202
4  2013          259
5  2014          252
6  2015          234
7  2016          245
8  2017          247
9  2018          238

Krokem číslo tři se stane tvorba samotného grafu za pomoci příkazu geom_bar(stat = "identity"). Z jakého důvodu tu potřebujeme parametr stat = "identity"? Graf data na osu y přenáší přímo z proměnné Pravidelnost a nic přitom nepočítá. Opakem stat = "identity" je defaultně nastavený parametr stat = "bin", který využíváme například při tvorbě grafů, jež vychází z faktorové proměnné (vzpomeňte si na tvorbu grafů četnosti mužů a žen v Harare).

ggplot(Data,
  aes(x = Rok, y = Pravidelnost)) + 
  geom_bar(stat = "identity", fill = "#004990") +
  # pomocí fill určíme barvu sloupců
  
  geom_text(aes(y = Pravidelnost, label = Pravidelnost), 
            position =  position_stack(vjust = 0.5),
  # Pomocí vjust určíme polohu čísel uvnitř sloupců: 0.5 uprostřed, 
  # 1 na vrcholu, 0 dole.

            size = 5, 
            color = "white") +
  ggtitle(expression(atop(bold("Vývoj počtu vypravených spojů"),
                          atop("jedoucích za celý týden bez svátků"), ""))) +
  theme_economist() +
  scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    # pomocí fill definujeme pozadí grafu, pomocí colour jeho okraj

    legend.title = element_blank())

Následující úkol bude již o trochu obtížnější, ale doopravdy jen o trochu. Skript bude vycházet z předchozího příkladu pouze s tím rozdílem, že v něm budeme chtít rozlišit dopravní špičku (v čase od 14:00 do 19:00 hodin) od zbytku dne.

library(dplyr)
library(ggplot2)    
library(ggthemes)   

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)

Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)

Praha_Ostrava$Špička <- (ifelse(
  Praha_Ostrava$Odjezd >= " 1899-12-31 15:00:00 UTC" &
  Praha_Ostrava$Odjezd <= " 1899-12-31 20:00:00 UTC","
  Spoje mezi 14:00 až 19:00", "Ostatní spoje")) 

Data <- Praha_Ostrava %>%
  group_by(Rok, Špička) %>%
  summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost) 

ggplot(Data,
       aes(x = Rok, y = Pravidelnost, fill = Špička)) + 
  geom_bar(stat = "identity") +
  geom_text(aes(y = Pravidelnost, label = Pravidelnost), 
            position =  position_stack(vjust = 0.5), 
            size = 5, 
            color = "white") +
  ggtitle(expression(atop(bold("Vývoj počtu vypravených spojů"),
                          atop("jedoucích za celý týden bez svátků"), ""))) +
  scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
                     position = "bottom") +
  labs(x = "", y = "") +
  theme_economist() +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust=0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
  plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
  legend.title = element_blank()) +
  scale_fill_manual(labels = c("Dopravní špička od 14:00 - 19:00", "Ostatní spoje"), 
                    values = c("#004990", "#668fcc"))

Abychom úkol mohli vyřešit, museli jsme do předcházejícího skriptu doplnit nový příkaz ifelse(), díky němuž jsme v rámci databáze Praha_Ostrava vytvořili novou proměnnou s názvem Špička. Na příkazu ifelse() není vcelku nic zajímavého až na dva příkazy, které jemu předchází.

Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)

S časy bývá někdy potíž, proto je dobré, pokud s nimi pracujeme, znovu nastavit jejich datový typ. Z jakého důvodu? Po výše uvedených příkazech pracujeme s příkazem ifelse(), který dělí čas na dvě období: na špičku a mimo ni. Tyto dvě období definujeme přesným časovým vymezením, a právě zde může nastat potíž kvůli časovému posunu. Jinými slovy, čas který vidíte v levém horním panelu po zadání příkazu View(Praha_Ostrava) může R interpretovat jinak a to s určitým, třeba hodinovým či delším posunem. Ostatně vyzkoušejte sami celý předchozí skript našeho druhého příkladu bez uvedení příkazů as.character(), respektive as.POSIXct(). Je totiž velmi pravděpodobné, že následující kód:

Praha_Ostrava$Špička <- (ifelse(
  Praha_Ostrava$Odjezd >= " 1899-12-31 14:00:00 UTC" &
  Praha_Ostrava$Odjezd <= " 1899-12-31 19:00:00 UTC",
  "Spoje mezi 14:00 až 19:00", "Ostatní spoje")) 

Praha_Ostrava[c(2, 10, 18), c(1, 2, 3, 24)]
# Aby se nám vše přehledně vešlo na obrazovku, provedeme
# výběr vybraných řádků a sloupců.
# A tibble: 3 x 4
    Rok Dopravce Odjezd              Špička                   
  <dbl> <chr>    <dttm>              <chr>                    
1  2010 ČD_SC    1899-12-31 13:26:00 Spoje mezi 14:00 až 19:00
2  2010 ČD       1899-12-31 13:30:00 Spoje mezi 14:00 až 19:00
3  2010 ČD       1899-12-31 18:11:00 Ostatní spoje            

bude ve skutečnosti definovat špičku nikoliv jako čas mezi 14:00 - 19:00, ale jako čas mezi 13:00 - 18:00. Abychom se tomuto problému vyhnuli, změnili jsme nejdříve čas na datový typ character a ten následně zpět na čas. V případě, že bychom vynechali příkaz as.character() nedosáhli bychom žádné změny. Z tohoto důvodu, pokud pracujete s časy, vždy si své výsledky kontrolujte a nikdy nespoléhejte ani na zdánlivě správný a bezchybný skript, který žádný error nehlásí.

Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)

Praha_Ostrava$Špička <- (ifelse(
  Praha_Ostrava$Odjezd >= " 1899-12-31 14:00:00 UTC" &
  Praha_Ostrava$Odjezd <= " 1899-12-31 19:00:00 UTC",
  "Spoje mezi 14:00 až 19:00", "Ostatní spoje")) 

Praha_Ostrava[c(2, 10, 18), c(1, 2, 3, 24)]
# A tibble: 3 x 4
    Rok Dopravce Odjezd              Špička                   
  <dbl> <chr>    <dttm>              <chr>                    
1  2010 ČD_SC    1899-12-31 13:26:00 Ostatní spoje            
2  2010 ČD       1899-12-31 13:30:00 Ostatní spoje            
3  2010 ČD       1899-12-31 18:11:00 Spoje mezi 14:00 až 19:00

Na rozdíl od času, graf neukrývá již žádnou významnou překážku.

ggplot(Data,
       aes(x = Rok, y = Pravidelnost, fill = Špička)) + 
  geom_bar(stat = "identity") +
  geom_text(aes(y = Pravidelnost, label = Pravidelnost), 
            position =  position_stack(vjust = 0.5), 
            size = 5, 
            color = "white") +
  ggtitle(expression(atop(bold("Vývoj počtu vypravených spojů"),
                          atop("jedoucích za celý týden bez svátků"), ""))) +
  scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
                     position = "bottom") +
  labs(x = "", y = "") +
  theme_economist() +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
  plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
  legend.title = element_blank()) +
  scale_fill_manual(labels = c("Dopravní špička od 14:00 - 19:00", "Ostatní spoje"), 
                    values = c("#004990", "#668fcc"))

Třetí skript, který si tu v této lekci ukážeme, si klade ještě vyšší cíle. Budeme totiž chtít rozdělit údaje o počtech spojů jedoucích za celý kalendářní týden nejen podle let a odpolední špičky, ale i podle jednotlivých dopravců.

library(dplyr)
library(ggplot2)    
library(ggthemes) 

Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)

Praha_Ostrava$Špička <- (ifelse(
  Praha_Ostrava$Odjezd >= " 1899-12-31 14:00:00" &
  Praha_Ostrava$Odjezd <= " 1899-12-31 19:00:00",
  "Spoje mezi 14:00 až 19:00", "Ostatní spoje")) 

Data <- Praha_Ostrava %>%
  group_by(Rok, Špička, Dopravce) %>%
  summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost) 

labels = cD = "ČD IC/EC/Ex", ČD_SC = "ČD SC Pendolino", LE = "Leo Express", 
            RJ = "RegioJet")

ggplot(Data, 
  aes(x = Rok, y = Pravidelnost, fill = Špička)) + 
  facet_grid(cols = vars(Dopravce), labeller = labeller(Dopravce = labels)) +
  geom_bar(stat = "identity") + 
  geom_text(aes(y = Pravidelnost, label = Pravidelnost), 
            position =  position_stack(vjust = 0.5), 
            size = 3, 
            color = "white") +
  ggtitle(expression(atop(bold("Vývoj počtu spojů podle dopravců"), 
                          atop("mezi léty 2010 až 2018"), ""))) +
  theme_economist() +
  scale_y_continuous(breaks = seq(from = 0, to = 100, by = 10)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 2), 
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, 
                              face = "bold", hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(angle = 45, hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    legend.title = element_blank()) +
  scale_fill_manual(values = c("#004990", "#668fcc"))

Výše uvedený skript byl oproti předchozímu příkladu obohacen o jeden, respektive dva pokyny. Nejdříve bylo nutné vytvořit proměnnou labels s názvy jednotlivých dopravců tak, jak je budeme chtít vidět v samotném grafu.

labels = cD = "ČD IC/EC/Ex", ČD_SC = "ČD SC Pendolino", 
           LE = "Leo Express", RJ = "RegioJet")

V následujícím kroku jsme přidali nám už dobře známý příkaz facet_grid(), díky čemuž jsme vytvořili čtyři vedle sebe stojící grafy.

facet_grid(cols = vars(Dopravce), labeller = labeller(Dopravce = labels)) +

# nebo zkráceně
facet_grid(~Dopravce, labeller = labeller(Dopravce = labels))

# V jakém pořadí označit jednotlivé dopravce ve
# výše uvedené proměnné labels? Podle abecedy.
# levels(as.factor(Praha_Ostrava$Dopravce)), 
# respektive levels(Praha_Ostrava$Dopravce)
# [1] "ČD"    "ČD_SC" "LE"    "RJ"  

# postup změny pořadí hodnot ve faktoru
# množství <- factor(c("málo", "hodně", "hodně", "málo", "středně"))
# množství
#     [1] málo  hodně  hodně  málo  středně
#     Levels: hodně středně málo

# množství <- factor(množství, levels = c("málo", "středně", "hodně"))
# množství
#     [1] málo  hodně  hodně  málo  středně
#     Levels: málo středně hodně

Poslední čtvrtý příklad bude na rozdíl od těch předcházejících trochu odlišný. Naším cílem totiž bude sestrojit sloupcových graf, jenž bude zobrazovat procentuální podíly jednotlivých dopravců měřenými počtem vypravených vlaků za kalendářní týden.

library(dplyr)
library(ggplot2)    
library(ggthemes) 

Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)

Data <- Praha_Ostrava %>%
  group_by(Rok, Dopravce) %>%
  summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost) %>%
  group_by(Rok) %>%
  mutate(Dohromady = sum(Pravidelnost)) %>%
  mutate(Podíl = Pravidelnost/Dohromady)

ggplot(Data,
       aes(x = Rok, y = Podíl, fill = Dopravce)) + 
  geom_bar(stat = "identity") +
  geom_text(aes(y = Podíl, label = paste(round(Podíl,2)*100, "%")), 
            position =  position_stack(vjust = 0.5),
            size = 4, 
            hjust = 0.5, 
            color = "white") +
  ggtitle("Procentuální zastoupení vypravených souprav") +
  theme_economist() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1), 
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    legend.title = element_blank()) +
  scale_fill_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino", 
                               "Leo Express", "RegioJet"), 
                    values = c("#004990", "#668fcc", "#141414", "#FBBF20"))

Nejobtížnější část tohoto skriptu se ukrývá hned na začátku během tvorby data frame. Projděme si jeho strukturu krok za krokem. Začátek je naprosto standardní jako u předchozích grafů, jelikož spočívá ve vytvoření proměnné Pravidelnost. Následně dojde k sečtení jednotlivých vlakových spojů podle let a dopravců. Výsledek příkazu summarise_each() poté pošleme trubkou do group_by(Rok), který je následován dvěma příkazy mutate(). mutate() zde požíváme místo summarise() proto, jelikož chceme zachovat členění tabulky na roky a dopravce (viz group_by(Rok, Dopravce)). Pokud bychom zvolili summarise(), zůstalo by nám rozdělení pouze na léta (viz příkaz group_by(Rok)). Pomocí prvního příkazu mutate() zjistíme celkový počet vypravených souprav bez ohledu na dopravce v daném roce. Poslední příkaz mutate() nám následně vytvoří proměnnou Podíl, která symbolizuje konečné podíly jednotlivých dopravců na trhu (měřenými počtem vypravených spojů, tj. nikoliv skutečnými tržními podíly).

Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)

Data <- Praha_Ostrava %>%
  group_by(Rok, Dopravce) %>%
  summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost) %>%
  group_by(Rok) %>%
  mutate(Dohromady = sum(Pravidelnost)) %>%
  mutate(Podíl = Pravidelnost/Dohromady)
# A tibble: 32 x 5
# Groups:   Rok [9]
     Rok Dopravce Pravidelnost Dohromady Podíl
   <dbl> <chr>           <int>     <int> <dbl>
 1  2010 ČD                 93       140 0.664
 2  2010 ČD_SC              47       140 0.336
 3  2011 ČD                 85       195 0.436
 4  2011 ČD_SC              50       195 0.256
 5  2011 RJ                 60       195 0.308
 6  2012 ČD                 84       202 0.416
 7  2012 ČD_SC              58       202 0.287
 8  2012 RJ                 60       202 0.297
 9  2013 ČD                 84       259 0.324
10  2013 ČD_SC              55       259 0.212
# ... with 22 more rows

V závěru už jen stačí vytvořit standardní sloupcový graf, v němž opět nesmíme zapomenout na geom_bar(stat = "identity"). V případě, že vám ale formát výše zobrazeného grafu nevyhovuje a vy byste raději preferovali, aby jednotlivé sloupce stály vedle sebe a nebyly tudíž poskládány na sebe, využijte příkaz position = "dodge" v rámci příkazu geom_bar() pro samotnou podobu grafu a tentýž příkaz position = "dodge" pro geom_text() (tj. textové popisky v grafu).

ggplot(Data,
       aes(x = Rok, y = Podíl, fill = Dopravce)) + 
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), 
            aes(label = (round(Podíl, 2))*100, y = Podíl), 
            size = 3, 
            hjust = 0.5, 
            vjust = 2, 
            color = "white") +
  ggtitle(expression(
    atop(bold("Procentuální zastoupení vypravených souprav"), ""))) +
  theme_economist() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1), 
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust=0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", 
                                   colour = "#DBE5F1"),
    legend.title = element_blank()) +
  scale_fill_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino", 
                               "Leo Express", "RegioJet"), 
                    values = c("#004990", "#668fcc", "#141414", "#FBBF20"))

Sedmá kapitola je za námi. S balíčkem tidyverse nicméně stále nekončíme, jelikož jím začneme i poslední osmou kapitolu. V ní se kromě jiného naučíme, jak naše krásné výtvory v R prezentovat světu ve formě graficky atraktivních webových stránek.

Column

Příklady

Příklad 7

Vytvořte sloupcový graf, který bude zobrazovat počty spojů jedoucích veškeré pracovní dny (jeden spoj bude tudíž symbolizovat všech pět spojů v týdnu) bez ohledu na dopravce. Rozdělení proveďte podle jednotlivých let a denní špičky (mezi 14:00 - 19:00). V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.

Příklad 8

Vytvořte sloupcový graf, který bude zobrazovat počty všech spojů jedoucích za celý týden mezi Prahou a Ostravou podle jednotlivých let bez ohledu na dopravce s rozdělením na ranní spoje (5:00 až 8:59), (do)polední spoje (9:00 až 12:59), odpolední spoje (13:00 až 16:59), večerní spoje (17:00 až 20:59) a noční spoje (21:00 až 4:59). V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.

Příklad 9

K předchozímu příkladu 8 přidejte rozdělení podle jednotlivých dopravců. Oproti předchozímu příkladu však budeme chtít, aby hodnoty na y-ové ose zobrazovaly stejně jako v příkladu 7 pouze počty těch spojů, které jezdí po všechny pracovní dny. V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.

Příklady

Column

Column

Příklady: řešení

Příklad 1

S pomocí trubky vytvořte datovou tabulku s názvem Data_z_trubky, která bude obsahovat proměnné Věk, Pohlaví, Vzdělání a Kouření. Názvy těchto proměnných následně přejmenujte na jejich anglické ekvivalenty. V dalších kroku zajistěte, aby v databázi byli zařazeni pouze jedinci ve věku 18 až 26 let (včetně). Na úplný závěr seřaďte hodnoty v proměnných podle věku, pohlaví, vzdělání a kouření v tomto pořadí.

Data_z_trubky <- Katan %>%  
  select(Věk, Pohlaví, Vzdělání, Kouření) %>%
  rename("Age" = Věk, "Gender" = Pohlaví, 
         "Education" = Vzdělání, "Smoke" = Kouření) %>%
  filter(Age >= 18 & Age <= 26) %>%
  arrange(Age, Gender, Education, Smoke)
# A tibble: 92 x 4
     Age Gender Education Smoke  
   <dbl> <chr>  <chr>     <chr>  
 1    18 muž    ZŠ        nekouří
 2    18 muž    ZŠ        nekouří
 3    18 muž    ZŠ        nekouří
 4    18 žena   SŠ        nekouří
 5    18 žena   SŠ        nekouří
 6    18 žena   ZŠ        kouří  
 7    18 žena   ZŠ        nekouří
 8    19 muž    ZŠ        nekouří
 9    19 muž    ZŠ        nekouří
10    19 muž    ZŠ        nekouří
# ... with 82 more rows

Příklad 2

Zjistěte v následujících věkových skupinách (teenager do 18 let, dospělý od 18 do 26 let, dospělý od 26 do 35 let, dospělý od 35 do 65 let, důchodce 65 let a více) zastoupení mužů a žen a jejich průměrný počet partií na osobu. Ve skriptu využijte příkaz trubka.

Katan2 <- Katan %>%
    mutate(VěkSkupiny = cut(Věk,
    breaks = c(0, 18, 26, 35, 65, 100),
    right = FALSE,
    labels = c("teenager do 18 let", "dospělý od 18 do 26 let",
               "dospělý od 26 do 35 let", "dospělý od 35 do 65 let", 
               "důchodce 65 let a více"))) %>%
    group_by(Pohlaví, VěkSkupiny) %>%
    summariseetnost_abs = n(), 
              Průměr = mean(Partie))
# A tibble: 9 x 4
# Groups:   Pohlaví [2]
  Pohlaví Skupiny                 Četnost_abs Průměr
  <chr>   <fct>                         <int>  <dbl>
1 muž     teenager do 18 let               16   5.5 
2 muž     dospělý od 18 do 26 let          47   3.85
3 muž     dospělý od 26 do 35 let          43   1.67
4 muž     dospělý od 35 do 65 let          32   1.53
5 muž     důchodce 65 let a více            4   1.5 
6 žena    teenager do 18 let               10   4.8 
7 žena    dospělý od 18 do 26 let          38   3.97
8 žena    dospělý od 26 do 35 let           7   2.57
9 žena    dospělý od 35 do 65 let           3   2   

Příklad 3

Zjistěte průměr, medián a směrodatnou odchylku u proměnných Partie a Věk. Hodnoty určete pro skupiny rozřazené dle proměnných Vzdělání a Pohlaví (tj. ZŠ - muž, ZŠ - žena, SŠ - muž, SŠ - žena atd.). Ve skriptu využijte příkaz trubka.

Katan %>%
  group_by(Vzdělání, Pohlaví) %>%
  summarise_each(funs(mean, median, sd), Partie, Věk)
# A tibble: 8 x 8
# Groups:   Vzdělání [4]
  Vzdělání Pohlaví Partie_mean Věk_mean Partie_median Věk_median Partie_sd
  <chr>    <chr>         <dbl>    <dbl>         <dbl>      <dbl>     <dbl>
1 Bc - VŠ  muž            3.67     23.2             3         23     1.51 
2 Bc - VŠ  žena           2.69     24.7             3         25     1.11 
3 SŠ       muž            2.83     30.1             2         25     1.93 
4 SŠ       žena           4.26     22.7             4         21     2.24 
5 VŠ       muž            1.63     31.9             1         31     0.859
6 VŠ       žena           2.44     27               3         26     1.01 
7 ZŠ       muž            4.36     27.1             5         17     2.48 
8 ZŠ       žena           5.23     16               4         16     2.31 
# ... with 1 more variable: Věk_sd <dbl>

Příklad 4

V databázi hflights zjistěte nejdelší zpoždění za jednotlivé měsíce v roce. Samotný výstup by měl obsahovat pouze proměnné Month, DepDelay a UniqueCarrier, které budou ve výsledné databázi s názvem Zpoždění pojmenovány českými ekvivalenty. Ve skriptu využijte příkaz trubka.

Zpoždění <- flights %>%
    group_by(Month) %>%
    select(Month, DepDelay, UniqueCarrier) %>%
    top_n(1, DepDelay) %>%
    rename("Měsíc" = Month, "Zpoždění" = DepDelay, "Přepravce" = UniqueCarrier)
# A tibble: 12 x 3
# Groups:   Měsíc [12]
   Měsíc Zpoždění Přepravce
   <int>    <int> <chr>    
 1     1      780 CO       
 2     2      507 FL       
 3     3      535 UA       
 4     4      548 WN       
 5     5      803 MQ       
 6     6      869 UA       
 7     7      420 CO       
 8     8      981 CO       
 9     9      588 UA       
10    10      730 DL       
11    11      931 MQ       
12    12      970 AA       

Příklad 5

Vytvořte liniový graf kumulativního vývoje počtu spojů mezi Prahou a Ostravou mezi léty 2010 až 2018 pro veškeré spoje Českých drah. Z tohoto důvodu nezapomeňte, že se jedná nejen o spoje typu ČD IC/EC/Ex (označení ČD v proměnné Dopravce), ale i o spoje ČD SC Pendolino (označení ČD_SC v proměnné Dopravce).

library(dplyr)
library(ggplot2)    
library(ggthemes)   

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)

Data <-  Praha_Ostrava %>%
  filter(Dopravce == "ČD" | Dopravce == "ČD_SC" ) %>%
  group_by(Rok) %>%
  summarise(Součet = sum(Pravidelnost)) %>%
  mutate(Kumul = round((Součet/Součet[1]-1),3))

ggplot(Data, 
  aes(x = Rok, y = Kumul)) + 
  geom_line(colour = "#004990", size = 2) +
  ggtitle(expression(
    atop(bold("Kumulativní vývoj spojů Českých drah"), 
    atop("mezi léty 2010 až 2018"), ""))) +
  theme_economist() +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust=0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    legend.title = element_blank())

Příklad 6

Vytvořte liniový graf mediánu jízdních dob mezi Prahou a Ostravou mezi léty 2010 až 2018 pro jednotlivé dopravce zvlášť. Rozlišujte prosím mezi spoji typu ČD IC/EC/Ex (označení ČD v proměnné Dopravce) a ČD SC Pendolino (označení ČD_SC v proměnné Dopravce).

library(dplyr)
library(ggplot2)    
library(ggthemes) 

Data <- Praha_Ostrava %>%
  group_by(Rok, Dopravce) %>%
  summarise_each(funs(median(., na.rm = TRUE)), Čas)

ggplot(Data,
  aes(x = Rok, y = Čas, colour = Dopravce)) +
  geom_line(size = 2) +
  ggtitle("Vývoj mediánové jízdní doby") +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1)) +
  scale_y_datetime(date_breaks = "10 mins", date_labels='%H:%M') +
  theme_economist() +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold", hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    legend.title = element_blank()) +
  scale_color_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino", 
                                "Leo Express", "RegioJet"), 
                     values = c("#004990", "#668fcc", "#141414", "#FBBF20"))

Příklad 7

Vytvořte sloupcový graf, který bude zobrazovat počty spojů jedoucích veškeré pracovní dny (jeden spoj bude tudíž symbolizovat všech pět spojů v týdnu) bez ohledu na dopravce. Rozdělení proveďte podle jednotlivých let a denní špičky (mezi 14:00 - 19:00).

library(dplyr)
library(ggplot2)    
library(ggthemes) 

Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)

Praha_Ostrava$Špička <- (ifelse(
  Praha_Ostrava$Odjezd >= " 1899-12-31 15:00:00" &
  Praha_Ostrava$Odjezd <= " 1899-12-31 20:00:00",
  "Spoje mezi 14:00 až 19:00", "Ostatní spoje")) 

Data <-  Praha_Ostrava %>%
  filter(Frekvence == 12345 | Frekvence == 1234567 | 
           Frekvence == 123456 | Frekvence == 123457)

ggplot(Data, 
       aes(x = Rok, fill = Špička)) + 
  geom_bar() +
  geom_text(stat = "count", position = position_stack(vjust = 0.5), 
            aes(label = ..count.., y = ..count..), 
            size = 5, 
            color = "white") +
  ggtitle(expression(
    atop(bold("Vývoj počtu vypravených spojů"), 
    atop("počítáno 1 x za veškeré pracovní dny"), ""))) +
  theme_economist() +
  scale_y_continuous(breaks = seq(from = 0, to = 35, by = 5)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold",
                              hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    legend.title = element_blank()) +
  scale_fill_manual(values = c("#004990", "#668fcc")) 

Příklad 8

Vytvořte sloupcový graf, který bude zobrazovat počty všech spojů jedoucích za celý týden mezi Prahou a Ostravou podle jednotlivých let bez ohledu na dopravce s rozdělením na ranní spoje (5:00 až 8:59), dopolední spoje (9:00 až 12:59), odpolední spoje (13:00 až 16:59), večerní spoje (17:00 až 20:59) a noční spoje (21:00 až 4:59).

library(dplyr)
library(ggplot2)    
library(ggthemes) 

Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)

Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)

Praha_Ostrava$Doba <-  
  ifelse(
    Praha_Ostrava$Odjezd >= " 1899-12-31 05:00:00" &
    Praha_Ostrava$Odjezd <= " 1899-12-31 08:59:59",
    "ranní spoj",
  ifelse(
    Praha_Ostrava$Odjezd >= " 1899-12-31 9:00:00" &
    Praha_Ostrava$Odjezd <= " 1899-12-31 12:59:59",
    "dopolední spoj",
  ifelse(
    Praha_Ostrava$Odjezd >= " 1899-12-31 13:00:00" &
    Praha_Ostrava$Odjezd <= " 1899-12-31 16:59:59",
    "odpolední spoj",
  ifelse(
    Praha_Ostrava$Odjezd >= " 1899-12-31 17:00:00" &
    Praha_Ostrava$Odjezd <= " 1899-12-31 20:59:59",
    "večerní spoj","noční spoj"))))

Data5 <- Praha_Ostrava %>%
  group_by(Rok, Doba) %>%
  summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost) 

ggplot(Data5, 
       aes(x = Rok, y = Pravidelnost, fill = Doba)) + 
  geom_bar(stat = 'identity') +
  geom_text(aes(y = Pravidelnost, label = Pravidelnost), 
            position = position_stack(vjust = 0.5), size = 5, 
            color = "white") +
  ggtitle(expression(atop(bold("Vývoj počtu spojů"), 
                          atop("jedoucích za celý týden podle denní doby"), ""))) +
  theme_economist() +
  scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1), 
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold", hjust = 0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    legend.title = element_blank()) +
  scale_fill_manual(
    labels = c("Ranní spoj", "Dopolední spoj", "Odpolední spoj", 
               "Večerní spoj", "Noční spoj"), 
    values = c("#060b13", "#192e4d", "#2d5086", "#3967ac", "#668fcc"))

Příklad 9

K předchozímu příkladu 8 přidejte rozdělení podle jednotlivých dopravců. Oproti předchozímu příkladu však budeme chtít, aby hodnoty na y-ové ose zobrazovaly stejně jako v příkladu 7 pouze počty těch spojů, které jezdí po všechny pracovní dny.

library(dplyr)
library(ggplot2)    
library(ggthemes) 

Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)

Praha_Ostrava$Doba <-  
  ifelse(
    Praha_Ostrava$Odjezd >= " 1899-12-31 05:00:00" &
    Praha_Ostrava$Odjezd <= " 1899-12-31 08:59:59",
    "ranní spoj",
  ifelse(
    Praha_Ostrava$Odjezd >= " 1899-12-31 9:00:00" &
    Praha_Ostrava$Odjezd <= " 1899-12-31 12:59:59",
    "dopolední spoj",
  ifelse(
    Praha_Ostrava$Odjezd >= " 1899-12-31 13:00:00" &
    Praha_Ostrava$Odjezd <= " 1899-12-31 16:59:59",
    "odpolední spoj",
  ifelse(
    Praha_Ostrava$Odjezd >= " 1899-12-31 17:00:00" &
    Praha_Ostrava$Odjezd <= " 1899-12-31 20:59:59",
    "večerní spoj","noční spoj"))))

Data <-  Praha_Ostrava %>%
  filter(Frekvence == 12345 | Frekvence == 1234567 | 
         Frekvence == 123456 | Frekvence == 123457)

labels = cD = "ČD IC/EC/Ex", ČD_SC = "ČD SC Pendolino", 
            LE = "Leo Express", RJ = "RegioJet")

ggplot(Data, 
       aes(x = Rok, fill = Doba)) + 
  facet_grid(~Dopravce, labeller = labeller(Dopravce = labels)) +
  geom_bar() + 
  ggtitle(expression(atop(bold("Vývoj počtu spojů podle dopravců a denní doby"), 
                          atop("počítáno 1 x za veškeré pracovní dny"), ""))) +
  theme_economist() +
  scale_y_continuous(breaks = seq(from = 0, to = 12, by = 2)) +
  scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 2), 
                     position = "bottom") +
  labs(x = "", y = "") +
  theme(
    plot.title = element_text(color = "black", size = 20, face = "bold", hjust=0.5),
    axis.title.x = element_text(color = "black", size = 12),
    axis.title.y = element_text(color = "black", size = 12),
    axis.text.x = element_text(angle = 45, hjust = 0.5),
    plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
    legend.title = element_blank()) +
  scale_fill_manual(
    labels = c("Ranní spoj", "Dopolední spoj", "Odpolední spoj", 
               "Večerní spoj", "Noční spoj"), 
    values = c("#060b13", "#192e4d", "#2d5086", "#3967ac", "#668fcc"))

Column